home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / bonus.arc / SPIRAL.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1985-05-12  |  1.4 KB  |  47 lines
  1. ;
  2. ;       Display spiral
  3. ;
  4. ;       Designed and implemented by Kelvin R. Throop on 1985 January 85
  5. ;
  6. ;       (cspiral <# rotations> <base point> <growth per rotation>
  7. ;                <points per circle>)
  8. ;
  9. (defun cspiral (ntimes bpoint cfac lppass / ang dist tp ainc dinc circle bs cs)
  10.         (setq cs (getvar "cmdecho"))
  11.         (setq bs (getvar "blipmode"))
  12.         (setvar "blipmode" 0)
  13.         (setvar "cmdecho" 0)
  14.         (setq circle (* 3.141596235 2))
  15.         (setq ainc (/ circle lppass))
  16.         (setq dinc (/ cfac lppass))
  17.         (setq ang 0.0)
  18.         (setq dist 0.0)
  19.         (command "pline" bpoint)
  20.         (repeat ntimes
  21.            (repeat lppass
  22.               (setq tp (polar bpoint (setq ang (+ ang ainc))
  23.                           (setq dist (+ dist dinc))))
  24.               (command tp)
  25.            )
  26.         )
  27.         (command)
  28.         (setvar "blipmode" bs)
  29.         (setvar "cmdecho" cs)
  30.         nil
  31. )
  32. ;
  33. ;       Interactive spiral generation
  34. ;
  35. (defun C:SPIRAL ( / nt bp cf lp)
  36.         (prompt "\nCentre point: ")
  37.         (setq bp (getpoint))
  38.         (prompt "\nNumber of rotations: ")
  39.         (setq nt (getint))
  40.         (prompt "\nGrowth per rotation: ")
  41.         (setq cf (getdist bp))
  42.         (prompt "\nPoints per rotation: ")
  43.         (setq lp (getint))
  44.         (cond ((null lp) (setq lp 30)))
  45.         (cspiral nt bp cf lp)
  46. )
  47.